v class="head">
Theory Utils
theory Utils
imports Regular_Tree_Relations.Term_Context
Regular_Tree_Relations.FSet_Utils
begin
subsection â¹Miscâº
definition "funas_trs â = â ((λ (s, t). funas_term s ⪠funas_term t) ` â)"
fun linear_term :: "('f, 'v) term â bool" where
"linear_term (Var _) = True" |
"linear_term (Fun _ ts) = (is_partition (map vars_term ts) â§ (âtâset ts. linear_term t))"
fun vars_term_list :: "('f, 'v) term â 'v list" where
"vars_term_list (Var x) = [x]" |
"vars_term_list (Fun _ ts) = concat (map vars_term_list ts)"
fun varposs :: "('f, 'v) term â pos set" where
"varposs (Var x) = {[]}" |
"varposs (Fun f ts) = (âi<length ts. {i # p | p. p â varposs (ts ! i)})"
abbreviation "poss_args f ts ⡠map2 (λ i t. map ((#) i) (f t)) ([0 ..< length ts]) ts"
fun varposs_list :: "('f, 'v) term â pos list" where
"varposs_list (Var x) = [[]]" |
"varposs_list (Fun f ts) = concat (poss_args varposs_list ts)"
fun concat_index_split where
"concat_index_split (o_idx, i_idx) (x # xs) =
(if i_idx < length x
then (o_idx, i_idx)
else concat_index_split (Suc o_idx, i_idx - length x) xs)"
inductive_set trancl_list for â where
base[intro, Pure.intro] : "length xs = length ys â¹
(â i < length ys. (xs ! i, ys ! i) â â) â¹ (xs, ys) â trancl_list â"
| list_trancl [Pure.intro]: "(xs, ys) â trancl_list â â¹ i < length ys â¹ (ys ! i, z) â â â¹
(xs, ys[i := z]) â trancl_list â"
lemma sorted_append_bigger:
"sorted xs â¹ âx â set xs. x ⤠y â¹ sorted (xs @ [y])"
proof (induct xs)
case Nil
then show ?case by simp
next
case (Cons x xs)
then have s: "sorted xs" by (cases xs) simp_all
from Cons have a: "âxâset xs. x ⤠y" by simp
from Cons(1)[OF s a] Cons(2-) show ?case by (cases xs) simp_all
qed
lemma find_SomeD:
"List.find P xs = Some x â¹ P x"
"List.find P xs = Some x â¹ xâset xs"
by (auto simp add: find_Some_iff)
lemma sum_list_replicate_length' [simp]:
"sum_list (replicate n (Suc 0)) = n"
by (induct n) simp_all
lemma arg_subteq [simp]:
assumes "t â set ts" shows "Fun f ts âµ t"
using assms by auto
lemma finite_funas_term: "finite (funas_term s)"
by (induct s) auto
lemma finite_funas_trs:
"finite â â¹ finite (funas_trs â)"
by (induct rule: finite.induct) (auto simp: finite_funas_term funas_trs_def)
fun subterms where
"subterms (Var x) = {Var x}"|
"subterms (Fun f ts) = {Fun f ts} ⪠(â (subterms ` set ts))"
lemma finite_subterms_fun: "finite (subterms s)"
by (induct s) auto
lemma subterms_supteq_conv: "t â subterms s â· s âµ t"
by (induct s) (auto elim: supteq.cases)
lemma set_all_subteq_subterms:
"subterms s = {t. s âµ t}"
using subterms_supteq_conv by auto
lemma finite_subterms: "finite {t. s âµ t}"
unfolding set_all_subteq_subterms[symmetric]
by (simp add: finite_subterms_fun)
lemma finite_strict_subterms: "finite {t. s â³ t}"
by (intro finite_subset[OF _ finite_subterms]) auto
lemma finite_UN_I2:
"finite A â¹ (â B â A. finite B) â¹ finite (â A)"
by blast
lemma root_substerms_funas_term:
"the ` (root ` (subterms s) - {None}) = funas_term s" (is "?Ls = ?Rs")
proof -
thm subterms.induct
{fix x assume "x â ?Ls" then have "x â ?Rs"
proof (induct s arbitrary: x)
case (Fun f ts)
then show ?case
by auto (metis DiffI Fun.hyps imageI option.distinct(1) singletonD)
qed auto}
moreover
{fix g assume "g â ?Rs" then have "g â ?Ls"
proof (induct s arbitrary: g)
case (Fun f ts)
from Fun(2) consider "g = (f, length ts)" | "â t â set ts. g â funas_term t"
by (force simp: in_set_conv_nth)
then show ?case
proof cases
case 1 then show ?thesis
by (auto simp: image_iff intro: bexI[of _ "Some (f, length ts)"])
next
case 2
then obtain t where wit: "t â set ts" "g â funas_term t" by blast
have "g â the ` (root ` subterms t - {None})" using Fun(1)[OF wit] .
then show ?thesis using wit(1)
by (auto simp: image_iff)
qed
qed auto}
ultimately show ?thesis by auto
qed
lemma root_substerms_funas_term_set:
"the ` (root ` â (subterms ` R) - {None}) = â (funas_term ` R)"
using root_substerms_funas_term
by auto (smt DiffE DiffI UN_I image_iff)
lemma subst_merge:
assumes part: "is_partition (map vars_term ts)"
shows "âÏ. âi<length ts. âxâvars_term (ts ! i). Ï x = Ï i x"
proof -
let ?Ï = "map Ï [0 ..< length ts]"
let ?Ï = "fun_merge ?Ï (map vars_term ts)"
show ?thesis
by (rule exI[of _ ?Ï], intro allI impI ballI,
insert fun_merge_part[OF part, of _ _ ?Ï], auto)
qed
lemma rel_comp_empty_trancl_simp: "R O R = {} â¹ Râ§+ = R"
by (metis O_assoc relcomp_empty2 sup_bot_right trancl_unfold trancl_unfold_right)
lemma choice_nat:
assumes "âi<n. âx. P x i"
shows "âf. âx<n. P (f x) x" using assms
proof -
from assms have "â i. â x. i < n â¶ P x i" by simp
from choice[OF this] show ?thesis by auto
qed
lemma subseteq_set_conv_nth:
"(â i < length ss. ss ! i â T) â· set ss â T"
by (metis in_set_conv_nth subset_code(1))
lemma singelton_trancl [simp]: "{a}â§+ = {a}"
using tranclD tranclD2 by fastforce
context
includes fset.lifting
begin
lemmas frelcomp_empty_ftrancl_simp = rel_comp_empty_trancl_simp [Transfer.transferred]
lemmas in_fset_idx = in_set_idx [Transfer.transferred]
lemmas fsubseteq_fset_conv_nth = subseteq_set_conv_nth [Transfer.transferred]
lemmas singelton_ftrancl [simp] = singelton_trancl [Transfer.transferred]
end
lemma set_take_nth:
assumes "x â set (take i xs)"
shows "â j < length xs. j < i â§ xs ! j = x" using assms
by (metis in_set_conv_nth length_take min_less_iff_conj nth_take)
lemma nth_sum_listI:
assumes "length xs = length ys"
and "â i < length xs. xs ! i = ys ! i"
shows "sum_list xs = sum_list ys"
using assms nth_equalityI by blast
lemma concat_nth_length:
"i < length uss â¹ j < length (uss ! i) â¹
sum_list (map length (take i uss)) + j < length (concat uss)"
by (induct uss arbitrary: i j) (simp, case_tac i, auto)
lemma sum_list_1_E [elim]:
assumes "sum_list xs = Suc 0"
obtains i where "i < length xs" "xs ! i = Suc 0" "â j < length xs. j â i â¶ xs ! j = 0"
proof -
have "â i < length xs. xs ! i = Suc 0 â§ (â j < length xs. j â i â¶ xs ! j = 0)" using assms
proof (induct xs)
case (Cons a xs) show ?case
proof (cases a)
case [simp]: 0
obtain i where "i < length xs" "xs ! i = Suc 0" "(â j < length xs. j â i â¶ xs ! j = 0)"
using Cons by auto
then show ?thesis using less_Suc_eq_0_disj
by (intro exI[of _ "Suc i"]) auto
next
case (Suc nat) then show ?thesis using Cons by auto
qed
qed auto
then show " (âi. i < length xs â¹ xs ! i = Suc 0 â¹ âj<length xs. j â i â¶ xs ! j = 0 â¹ thesis) â¹ thesis"
by blast
qed
lemma nth_equalityE:
"xs = ys â¹ (length xs = length ys â¹ (âi. i < length xs â¹ xs ! i = ys ! i) â¹ P) â¹ P"
by simp
lemma map_cons_presv_distinct:
"distinct t â¹ distinct (map ((#) i) t)"
by (simp add: distinct_conv_nth)
lemma concat_nth_nthI:
assumes "length ss = length ts" "â i < length ts. length (ss ! i) = length (ts ! i)"
and "â i < length ts. â j < length (ts ! i). P (ss ! i ! j) (ts ! i ! j)"
shows "â i < length (concat ts). P (concat ss ! i) (concat ts ! i)"
using assms by (metis nth_concat_two_lists)
lemma last_nthI:
assumes "i < length ts" "¬ i < length ts - Suc 0"
shows "ts ! i = last ts" using assms
by (induct ts arbitrary: i)
(auto, metis last_conv_nth length_0_conv less_antisym nth_Cons')
lemma trancl_list_appendI [simp, intro]:
"(xs, ys) â trancl_list â â¹ (x, y) â â â¹ (x # xs, y # ys) â trancl_list â"
proof (induct rule: trancl_list.induct)
case (base xs ys)
then show ?case using less_Suc_eq_0_disj
by (intro trancl_list.base) auto
next
case (list_trancl xs ys i z)
from list_trancl(3) have *: "y # ys[i := z] = (y # ys)[Suc i := z]" by auto
show ?case using list_trancl unfolding *
by (intro trancl_list.list_trancl) auto
qed
lemma trancl_list_append_tranclI [intro]:
"(x, y) â ââ§+ â¹ (xs, ys) â trancl_list â â¹ (x # xs, y # ys) â trancl_list â"
proof (induct rule: trancl.induct)
case (trancl_into_trancl a b c)
then have "(a # xs, b # ys) â trancl_list â" by auto
from trancl_list.list_trancl[OF this, of 0 c]
show ?case using trancl_into_trancl(3)
by auto
qed auto
lemma trancl_list_conv:
"(xs, ys) â trancl_list â â· length xs = length ys â§ (â i < length ys. (xs ! i, ys ! i) â ââ§+)" (is "?Ls â· ?Rs")
proof
assume "?Ls" then show ?Rs
proof (induct)
case (list_trancl xs ys i z)
then show ?case
by auto (metis nth_list_update trancl.trancl_into_trancl)
qed auto
next
assume ?Rs then show ?Ls
proof (induct ys arbitrary: xs)
case Nil
then show ?case by (cases xs) auto
next
case (Cons y ys)
from Cons(2) obtain x xs' where *: "xs = x # xs'" and
inv: "(x, y) â ââ§+"
by (cases xs) auto
show ?case using Cons(1)[of "tl xs"] Cons(2) unfolding *
by (intro trancl_list_append_tranclI[OF inv]) force
qed
qed
lemma trancl_list_induct [consumes 2, case_names base step]:
assumes "length ss = length ts" "â i < length ts. (ss ! i, ts ! i) â ââ§+"
and "âxs ys. length xs = length ys â¹ â i < length ys. (xs ! i, ys ! i) â â â¹ P xs ys"
and "âxs ys i z. length xs = length ys â¹ â i < length ys. (xs ! i, ys ! i) â ââ§+ â¹ P xs ys
â¹ i < length ys â¹ (ys ! i, z) â â â¹ P xs (ys[i := z])"
shows "P ss ts" using assms
by (intro trancl_list.induct[of ss ts â P]) (auto simp: trancl_list_conv)
lemma swap_trancl:
"(prod.swap ` R)â§+ = prod.swap ` (Râ§+)"
proof -
have [simp]: "prod.swap ` X = X¯" for X by auto
show ?thesis by (simp add: trancl_converse)
qed
lemma swap_rtrancl:
"(prod.swap ` R)â§* = prod.swap ` (Râ§*)"
proof -
have [simp]: "prod.swap ` X = X¯" for X by auto
show ?thesis by (simp add: rtrancl_converse)
qed
lemma Restr_simps:
"R â X Ã X â¹ Restr (Râ§+) X = Râ§+"
"R â X Ã X â¹ Restr Id X O R = R"
"R â X Ã X â¹ R O Restr Id X = R"
"R â X Ã X â¹ S â X Ã X â¹ Restr (R O S) X = R O S"
"R â X Ã X â¹ Râ§+ â X Ã X"
subgoal using trancl_mono_set[of R "X Ã X"] by (auto simp: trancl_full_on)
subgoal by auto
subgoal by auto
subgoal by auto
subgoal using trancl_subset_Sigma .
done
lemma Restr_tracl_comp_simps:
"â â X Ã X â¹ â â X Ã X â¹ ââ§+ O â â X Ã X"
"â â X Ã X â¹ â â X Ã X â¹ â O ââ§+ â X Ã X"
"â â X Ã X â¹ â â X Ã X â¹ ââ§+ O â O ââ§+ â X Ã X"
by (auto dest: subsetD[OF Restr_simps(5)[of â]] subsetD[OF Restr_simps(5)[of â]])
text â¹Conversions of the Nth function between lists and a spliting of the list into lists of listsâº
lemma concat_index_split_mono_first_arg:
"i < length (concat xs) ⹠o_idx ⤠fst (concat_index_split (o_idx, i) xs)"
by (induct xs arbitrary: o_idx i) (auto, metis Suc_leD add_diff_inverse_nat nat_add_left_cancel_less)
lemma concat_index_split_sound_fst_arg_aux:
"i < length (concat xs) â¹ fst (concat_index_split (o_idx, i) xs) < length xs + o_idx"
by (induct xs arbitrary: o_idx i) (auto, metis add_Suc_right add_diff_inverse_nat nat_add_left_cancel_less)
lemma concat_index_split_sound_fst_arg:
"i < length (concat xs) â¹ fst (concat_index_split (0, i) xs) < length xs"
using concat_index_split_sound_fst_arg_aux[of i xs 0] by auto
lemma concat_index_split_sound_snd_arg_aux:
assumes "i < length (concat xs)"
shows "snd (concat_index_split (n, i) xs) < length (xs ! (fst (concat_index_split (n, i) xs) - n))" using assms
proof (induct xs arbitrary: i n)
case (Cons x xs)
show ?case proof (cases "i < length x")
case False then have size: "i - length x < length (concat xs)"
using Cons(2) False by auto
obtain k j where [simp]: "concat_index_split (Suc n, i - length x) xs = (k, j)"
using old.prod.exhaust by blast
show ?thesis using False Cons(1)[OF size, of "Suc n"] concat_index_split_mono_first_arg[OF size, of "Suc n"]
by (auto simp: nth_append)
qed (auto simp add: nth_append)
qed auto
lemma concat_index_split_sound_snd_arg:
assumes "i < length (concat xs)"
shows "snd (concat_index_split (0, i) xs) < length (xs ! fst (concat_index_split (0, i) xs))"
using concat_index_split_sound_snd_arg_aux[OF assms, of 0] by auto
lemma reconstr_1d_concat_index_split:
assumes "i < length (concat xs)"
shows "i = (λ (m, j). sum_list (map length (take (m - n) xs)) + j) (concat_index_split (n, i) xs)" using assms
proof (induct xs arbitrary: i n)
case (Cons x xs) show ?case
proof (cases "i < length x")
case False
obtain m k where res: "concat_index_split (Suc n, i - length x) xs = (m, k)"
using prod_decode_aux.cases by blast
then have unf_ind: "concat_index_split (n, i) (x # xs) = concat_index_split (Suc n, i - length x) xs" and
size: "i - length x < length (concat xs)" using Cons(2) False by auto
have "Suc n ⤠m" using concat_index_split_mono_first_arg[OF size, of "Suc n"] by (auto simp: res)
then have [simp]: "sum_list (map length (take (m - n) (x # xs))) = sum_list (map length (take (m - Suc n) xs)) + length x"
by (simp add: take_Cons')
show ?thesis using Cons(1)[OF size, of "Suc n"] False unfolding unf_ind res by auto
qed auto
qed auto
lemma concat_index_split_larger_lists [simp]:
assumes "i < length (concat xs)"
shows "concat_index_split (n, i) (xs @ ys) = concat_index_split (n, i) xs" using assms
by (induct xs arbitrary: ys n i) auto
lemma concat_index_split_split_sound_aux:
assumes "i < length (concat xs)"
shows "concat xs ! i = (λ (k, j). xs ! (k - n) ! j) (concat_index_split (n, i) xs)" using assms
proof (induct xs arbitrary: i n)
case (Cons x xs)
show ?case proof (cases "i < length x")
case False then have size: "i - length x < length (concat xs)"
using Cons(2) False by auto
obtain k j where [simp]: "concat_index_split (Suc n, i - length x) xs = (k, j)"
using prod_decode_aux.cases by blast
show ?thesis using False Cons(1)[OF size, of "Suc n"]
using concat_index_split_mono_first_arg[OF size, of "Suc n"]
by (auto simp: nth_append)
qed (auto simp add: nth_append)
qed auto
lemma concat_index_split_sound:
assumes "i < length (concat xs)"
shows "concat xs ! i = (λ (k, j). xs ! k ! j) (concat_index_split (0, i) xs)"
using concat_index_split_split_sound_aux[OF assms, of 0] by auto
lemma concat_index_split_sound_bounds:
assumes "i < length (concat xs)" and "concat_index_split (0, i) xs = (m, n)"
shows "m < length xs" "n < length (xs ! m)"
using concat_index_split_sound_fst_arg[OF assms(1)] concat_index_split_sound_snd_arg[OF assms(1)]
by (auto simp: assms(2))
lemma concat_index_split_less_length_concat:
assumes "i < length (concat xs)" and "concat_index_split (0, i) xs = (m, n)"
shows "i = sum_list (map length (take m xs)) + n" "m < length xs" "n < length (xs ! m)"
"concat xs ! i = xs ! m ! n"
using concat_index_split_sound[OF assms(1)] reconstr_1d_concat_index_split[OF assms(1), of 0]
using concat_index_split_sound_fst_arg[OF assms(1)] concat_index_split_sound_snd_arg[OF assms(1)] assms(2)
by auto
lemma nth_concat_split':
assumes "i < length (concat xs)"
obtains j k where "j < length xs" "k < length (xs ! j)" "concat xs ! i = xs ! j ! k" "i = sum_list (map length (take j xs)) + k"
using concat_index_split_less_length_concat[OF assms]
by (meson old.prod.exhaust)
lemma sum_list_split [dest!, consumes 1]:
assumes "sum_list (map length (take i xs)) + j = sum_list (map length (take k xs)) + l"
and "i < length xs" "k < length xs"
and "j < length (xs ! i)" "l < length (xs ! k)"
shows "i = k â§ j = l" using assms
proof (induct xs rule: rev_induct)
case (snoc x xs)
then show ?case
by (auto simp: nth_append split: if_splits)
(metis concat_nth_length length_concat not_add_less1)+
qed auto
lemma concat_index_split_unique:
assumes "i < length (concat xs)" and "length xs = length ys"
and "â i < length xs. length (xs ! i) = length (ys ! i)"
shows "concat_index_split (n, i) xs = concat_index_split (n, i) ys" using assms
proof (induct xs arbitrary: ys n i)
case (Cons x xs) note IH = this show ?case
proof (cases ys)
case Nil then show ?thesis using Cons(3) by auto
next
case [simp]: (Cons y ys')
have [simp]: "length y = length x" using IH(4) by force
have [simp]: "¬ i < length x ⹠i - length x < length (concat xs)" using IH(2) by auto
have [simp]: "i < length ys' â¹ length (xs ! i) = length (ys' ! i)" for i using IH(3, 4)
by (auto simp: All_less_Suc) (metis IH(4) Suc_less_eq length_Cons Cons nth_Cons_Suc)
show ?thesis using IH(2-) IH(1)[of "i - length x" ys' "Suc n"] by auto
qed
qed auto
lemma set_vars_term_list [simp]:
"set (vars_term_list t) = vars_term t"
by (induct t) simp_all
lemma vars_term_list_empty_ground [simp]:
"vars_term_list t = [] â· ground t"
by (induct t) auto
lemma varposs_imp_poss:
assumes "p â varposs t"
shows "p â poss t"
using assms by (induct t arbitrary: p) auto
lemma vaposs_list_fun:
assumes "p â set (varposs_list (Fun f ts))"
obtains i ps where "i < length ts" "p = i # ps"
using assms set_zip_leftD by fastforce
lemma varposs_list_distinct:
"distinct (varposs_list t)"
proof (induct t)
case (Fun f ts)
then show ?case proof (induct ts rule: rev_induct)
case (snoc x xs)
then have "distinct (varposs_list (Fun f xs))" "distinct (varposs_list x)" by auto
then show ?case using snoc by (auto simp add: map_cons_presv_distinct dest: set_zip_leftD)
qed auto
qed auto
lemma varposs_append:
"varposs (Fun f (ts @ [t])) = varposs (Fun f ts) ⪠((#) (length ts)) ` varposs t"
by (auto simp: nth_append split: if_splits)
lemma varposs_eq_varposs_list:
"set (varposs_list t) = varposs t"
proof (induct t)
case (Fun f ts)
then show ?case proof (induct ts rule: rev_induct)
case (snoc x xs)
then have "varposs (Fun f xs) = set (varposs_list (Fun f xs))"
"varposs x = set (varposs_list x)" by auto
then show ?case using snoc unfolding varposs_append
by auto
qed auto
qed auto
lemma varposs_list_var_terms_length:
"length (varposs_list t) = length (vars_term_list t)"
by (induct t) (auto simp: vars_term_list.simps intro: eq_length_concat_nth)
lemma vars_term_list_nth:
assumes "i < length (vars_term_list (Fun f ts))"
and "concat_index_split (0, i) (map vars_term_list ts) = (k, j)"
shows "k < length ts â§ j < length (vars_term_list (ts ! k)) â§
vars_term_list (Fun f ts) ! i = map vars_term_list ts ! k ! j â§
i = sum_list (map length (map vars_term_list (take k ts))) + j"
using assms concat_index_split_less_length_concat[of i "map vars_term_list ts" k j]
by (auto simp: vars_term_list.simps comp_def take_map)
lemma varposs_list_nth:
assumes "i < length (varposs_list (Fun f ts))"
and "concat_index_split (0, i) (poss_args varposs_list ts) = (k, j)"
shows "k < length ts â§ j < length (varposs_list (ts ! k)) â§
varposs_list (Fun f ts) ! i = k # (map varposs_list ts) ! k ! j â§
i = sum_list (map length (map varposs_list (take k ts))) + j"
using assms concat_index_split_less_length_concat[of i "poss_args varposs_list ts" k j]
by (auto simp: comp_def take_map intro: nth_sum_listI)
lemma varposs_list_to_var_term_list:
assumes "i < length (varposs_list t)"
shows "the_Var (t |_ (varposs_list t ! i)) = (vars_term_list t) ! i" using assms
proof (induct t arbitrary: i)
case (Fun f ts)
have "concat_index_split (0, i) (poss_args varposs_list ts) = concat_index_split (0, i) (map vars_term_list ts)"
using Fun(2) concat_index_split_unique[of i "poss_args varposs_list ts" "map vars_term_list ts" 0]
using varposs_list_var_terms_length[of "ts ! i" for i]
by (auto simp: vars_term_list.simps)
then obtain k j where "concat_index_split (0, i) (poss_args varposs_list ts) = (k, j)"
"concat_index_split (0, i) (map vars_term_list ts) = (k, j)" by fastforce
from varposs_list_nth[OF Fun(2) this(1)] vars_term_list_nth[OF _ this(2)]
show ?case using Fun(2) Fun(1)[OF nth_mem] varposs_list_var_terms_length[of "Fun f ts"] by auto
qed (auto simp: vars_term_list.simps)
end
Theory Multihole_Context
section â¹Preliminariesâº
subsection â¹Multihole Contextsâº
theory Multihole_Context
imports
Utils
begin
unbundle lattice_syntax
subsubsection â¹Partitioning lists into chunks of given lengthâº
lemma concat_nth:
assumes "m < length xs" and "n < length (xs ! m)"
and "i = sum_list (map length (take m xs)) + n"
shows "concat xs ! i = xs ! m ! n"
using assms
proof (induct xs arbitrary: m n i)
case (Cons x xs)
show ?case
proof (cases m)
case 0
then show ?thesis using Cons by (simp add: nth_append)
next
case (Suc k)
with Cons(1) [of k n "i - length x"] and Cons(2-)
show ?thesis by (simp_all add: nth_append)
qed
qed simp
lemma sum_list_take_eq:
fixes xs :: "nat list"
shows "k < i â¹ i < length xs â¹ sum_list (take i xs) =
sum_list (take k xs) + xs ! k + sum_list (take (i - Suc k) (drop (Suc k) xs))"
by (subst id_take_nth_drop [of k]) (auto simp: min_def drop_take)
fun partition_by where
"partition_by xs [] = []" |
"partition_by xs (y#ys) = take y xs # partition_by (drop y xs) ys"
lemma partition_by_map0_append [simp]:
"partition_by xs (map (λx. 0) ys @ zs) = replicate (length ys) [] @ partition_by xs zs"
by (induct ys) simp_all
lemma concat_partition_by [simp]:
"sum_list ys = length xs â¹ concat (partition_by xs ys) = xs"
by (induct ys arbitrary: xs) simp_all
definition partition_by_idx where
"partition_by_idx l ys i j = partition_by [0..<l] ys ! i ! j"
lemma partition_by_nth_nth_old:
assumes "i < length (partition_by xs ys)"
and "j < length (partition_by xs ys ! i)"
and "sum_list ys = length xs"
shows "partition_by xs ys ! i ! j = xs ! (sum_list (map length (take i (partition_by xs ys))) + j)"
using concat_nth [OF assms(1, 2) refl]
unfolding concat_partition_by [OF assms(3)] by simp
lemma map_map_partition_by:
"map (map f) (partition_by xs ys) = partition_by (map f xs) ys"
by (induct ys arbitrary: xs) (auto simp: take_map drop_map)
lemma length_partition_by [simp]:
"length (partition_by xs ys) = length ys"
by (induct ys arbitrary: xs) simp_all
lemma partition_by_Nil [simp]:
"partition_by [] ys = replicate (length ys) []"
by (induct ys) simp_all
lemma partition_by_concat_id [simp]:
assumes "length xss = length ys"
and "âi. i < length ys â¹ length (xss ! i) = ys ! i"
shows "partition_by (concat xss) ys = xss"
using assms by (induct ys arbitrary: xss) (simp, case_tac xss, simp, fastforce)
lemma partition_by_nth:
"i < length ys â¹ partition_by xs ys ! i = take (ys ! i) (drop (sum_list (take i ys)) xs)"
by (induct ys arbitrary: xs i) (simp, case_tac i, simp_all add: ac_simps)
lemma partition_by_nth_less:
assumes "k < i" and "i < length zs"
and "length xs = sum_list (take i zs) + j"
shows "partition_by (xs @ y # ys) zs ! k = take (zs ! k) (drop (sum_list (take k zs)) xs)"
proof -
have "partition_by (xs @ y # ys) zs ! k =
take (zs ! k) (drop (sum_list (take k zs)) (xs @ y # ys))"
using assms by (auto simp: partition_by_nth)
moreover have "zs ! k + sum_list (take k zs) ⤠length xs"
using assms by (simp add: sum_list_take_eq)
ultimately show ?thesis by simp
qed
lemma partition_by_nth_greater:
assumes "i < k" and "k < length zs" and "j < zs ! i"
and "length xs = sum_list (take i zs) + j"
shows "partition_by (xs @ y # ys) zs ! k =
take (zs ! k) (drop (sum_list (take k zs) - 1) (xs @ ys))"
proof -
have "partition_by (xs @ y # ys) zs ! k =
take (zs ! k) (drop (sum_list (take k zs)) (xs @ y # ys))"
using assms by (auto simp: partition_by_nth)
moreover have "sum_list (take k zs) > length xs"
using assms by (auto simp: sum_list_take_eq)
ultimately show ?thesis by (auto) (metis Suc_diff_Suc drop_Suc_Cons)
qed
lemma length_partition_by_nth:
"sum_list ys = length xs â¹ i < length ys â¹ length (partition_by xs ys ! i) = ys ! i"
by (induct ys arbitrary: xs i; case_tac i) auto
lemma partition_by_nth_nth_elem:
assumes "sum_list ys = length xs" "i < length ys" "j < ys ! i"
shows "partition_by xs ys ! i ! j â set xs"
proof -
from assms have "j < length (partition_by xs ys ! i)" by (simp only: length_partition_by_nth)
then have "partition_by xs ys ! i ! j â set (partition_by xs ys ! i)" by auto
with assms(2) have "partition_by xs ys ! i ! j â set (concat (partition_by xs ys))" by auto
then show ?thesis using assms by simp
qed
lemma partition_by_nth_nth:
assumes "sum_list ys = length xs" "i < length ys" "j < ys ! i"
shows "partition_by xs ys ! i ! j = xs ! partition_by_idx (length xs) ys i j"
"partition_by_idx (length xs) ys i j < length xs"
unfolding partition_by_idx_def
proof -
let ?n = "partition_by [0..<length xs] ys ! i ! j"
show "?n < length xs"
using partition_by_nth_nth_elem[OF _ assms(2,3), of "[0..<length xs]"] assms(1) by simp
have li: "i < length (partition_by [0..<length xs] ys)" using assms(2) by simp
have lj: "j < length (partition_by [0..<length xs] ys ! i)"
using assms by (simp add: length_partition_by_nth)
have "partition_by (map ((!) xs) [0..<length xs]) ys ! i ! j = xs ! ?n"
by (simp only: map_map_partition_by[symmetric] nth_map[OF li] nth_map[OF lj])
then show "partition_by xs ys ! i ! j = xs ! ?n" by (simp add: map_nth)
qed
lemma map_length_partition_by [simp]:
"sum_list ys = length xs â¹ map length (partition_by xs ys) = ys"
by (intro nth_equalityI, auto simp: length_partition_by_nth)
lemma map_partition_by_nth [simp]:
"i < length ys â¹ map f (partition_by xs ys ! i) = partition_by (map f xs) ys ! i"
by (induct ys arbitrary: i xs) (simp, case_tac i, simp_all add: take_map drop_map)
lemma sum_list_partition_by [simp]:
"sum_list ys = length xs â¹
sum_list (map (λx. sum_list (map f x)) (partition_by xs ys)) = sum_list (map f xs)"
by (induct ys arbitrary: xs) (simp_all, metis append_take_drop_id sum_list_append map_append)
lemma partition_by_map_conv:
"partition_by xs ys = map (λi. take (ys ! i) (drop (sum_list (take i ys)) xs)) [0 ..< length ys]"
by (rule nth_equalityI) (simp_all add: partition_by_nth)
lemma UN_set_partition_by_map:
"sum_list ys = length xs â¹ (âxâset (partition_by (map f xs) ys). â (set x)) = â(set (map f xs))"
by (induct ys arbitrary: xs)
(simp_all add: drop_map take_map, metis UN_Un append_take_drop_id set_append)
lemma UN_set_partition_by:
"sum_list ys = length xs â¹ (âzs â set (partition_by xs ys). âx â set zs. f x) = (âx â set xs. f x)"
by (induct ys arbitrary: xs) (simp_all, metis UN_Un append_take_drop_id set_append)
lemma Ball_atLeast0LessThan_partition_by_conv:
"(âiâ{0..<length ys}. âxâset (partition_by xs ys ! i). P x) =
(âx â â(set (map set (partition_by xs ys))). P x)"
by auto (metis atLeast0LessThan in_set_conv_nth length_partition_by lessThan_iff)
lemma Ball_set_partition_by:
"sum_list ys = length xs â¹
(âx â set (partition_by xs ys). ây â set x. P y) = (âx â set xs. P x)"
proof (induct ys arbitrary: xs)
case (Cons y ys)
then show ?case
apply (subst (2) append_take_drop_id [of y xs, symmetric])
apply (simp only: set_append)
apply auto
done
qed simp
lemma partition_by_append2:
"partition_by xs (ys @ zs) = partition_by (take (sum_list ys) xs) ys @ partition_by (drop (sum_list ys) xs) zs"
by (induct ys arbitrary: xs) (auto simp: drop_take ac_simps split: split_min)
lemma partition_by_concat2:
"partition_by xs (concat ys) =
concat (map (λi . partition_by (partition_by xs (map sum_list ys) ! i) (ys ! i)) [0..<length ys])"
proof -
have *: "map (λi . partition_by (partition_by xs (map sum_list ys) ! i) (ys ! i)) [0..<length ys] =
map (λ(x,y). partition_by x y) (zip (partition_by xs (map sum_list ys)) ys)"
using zip_nth_conv[of "partition_by xs (map sum_list ys)" ys] by auto
show ?thesis unfolding * by (induct ys arbitrary: xs) (auto simp: partition_by_append2)
qed
lemma partition_by_partition_by:
"length xs = sum_list (map sum_list ys) â¹
partition_by (partition_by xs (concat ys)) (map length ys) =
map (λi. partition_by (partition_by xs (map sum_list ys) ! i) (ys ! i)) [0..<length ys]"
by (auto simp: partition_by_concat2 intro: partition_by_concat_id)
subsubsection â¹Multihole contexts definition and functionalitiesâº